home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / turbovis / tvtoys04.zip / RESTEST.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-18  |  17KB  |  496 lines
  1. (***************************************************************************
  2.   ResTest program
  3.   Official playground, odd bits and pieces, resources, config files etc
  4.   PJB October 8, 1993, Internet mail to d91-pbr@nada.kth.se
  5.   Copyright 1993, All Rights Reserved
  6.   Free source, use at your own risk.
  7.   If modified, please state so if you pass this around.
  8.  
  9.   Demonstrates video config files, resource fonts and video tests
  10.   configurability. This program doesn't look for VESA and V7 without
  11.   being told to do so, it saves the desktop video state and it gives
  12.   transparent user access to resource fonts. There is also a self
  13.   modifying menu.
  14.  
  15.   StoreCfg is currently used before ResDemoApp.Done so that no config
  16.   file is saved if the program aborts during initialization. This
  17.   was intended to prevent unnecessary elimination of video checks,
  18.   whether that is any good I don't know.
  19.  
  20.   Another approach is to save a config file before testing that says
  21.   no testing should be done, and another after the testing with full
  22.   testing enabled. This doesn't leave anything to the user, but the
  23.   program might crash the first time, if the video BIOS is picky.
  24.  
  25.     if not ConfigOK then    { No config file }
  26.     begin
  27.       StoreCfg;             { VideoTypesToCheck is [] }
  28.       VideoTypesToCheck:=[vtVesa,vtVideo7];
  29.     end;
  30.  
  31.     inherited Init;
  32.  
  33.     if not ConfigOK then    { No config file }
  34.       StoreCfg;             { VideoTypesToCheck is [vtVesa,vtVideo7] }
  35.  
  36.  
  37.   Be careful about using TV's message box in StoreCfg, though, there
  38.   might not be any application:
  39.  
  40.     if (S.Status<>stOK) and (Application<>Nil) then
  41.       MessageBox(...)
  42.  
  43.  
  44. ***************************************************************************)
  45. program ResTest;
  46.  
  47. {$I toyCfg}
  48.  
  49. {$B-,X+}
  50.  
  51. {$IFNDEF ResFonts}
  52.   Psst! Define ResFonts in TOYCFG.PAS, or this demo is gets boring!
  53. {$ENDIF}
  54.  
  55.   uses
  56.     App, Dialogs, Drivers, Menus, MsgBox, Objects, Views,
  57.     toyPrefs, {$I hcFile}
  58.     ColorBox, ColorSel,         (* Color selection dialog *)
  59.     TVPal, Pal,                 (* Palette changing dialog *)
  60.     FontDlg, FontFiles, HelpFile, ModeDlg, StrmRec, toyApp, toyUtils,
  61.     TVVideo, TVUtils, Vesa, Video;
  62.  
  63.   type
  64.     TResDemoApp =
  65.       object (TToyApp)
  66.         ResFile   : TResourceFile;
  67.         LinesMenu : PMenu;
  68.         constructor Init;
  69.         procedure InitMenubar; virtual;
  70.         procedure CalcLinesMenu;
  71.         procedure CreateResourceFile;
  72.         procedure HandleEvent(var Event:TEvent); virtual;
  73.         procedure StoreCfg;
  74.         procedure VideoTestsDialog(VT:SpecialVideoTypes);
  75.       end;
  76.  
  77.  
  78.   (*******************************************************************
  79.     Demo commands
  80.   *******************************************************************)
  81.   const
  82.     toyStart     = 100;
  83.     cm8p         = toyStart+0;
  84.     cm14p        = toyStart+1;
  85.     cm16p        = toyStart+2;
  86.     cmVideoMode  = toyStart+3;
  87.     cmVideoInfo  = toyStart+4;
  88.     cmSelectFont = toyStart+5;
  89.     cmVideoTests = toyStart+6;
  90.     cm12p        = toyStart+7;
  91.     cmColor      = toyStart+8;
  92.     cmPalette    = toyStart+9;
  93.  
  94.   const
  95.     CfgName      = 'RESTEST.CFG';
  96.     ResName      = 'RESTEST.REZ';
  97.  
  98.  
  99. (***************************************************************************
  100.   Things that belong in a unit
  101. ***************************************************************************)
  102.  
  103.   (*******************************************************************
  104.     Restore a video state from stream
  105.   *******************************************************************)
  106.   procedure LoadVideoState(var S:TStream);
  107.     var
  108.       W : Word;
  109.       TVVideoState : VideoState;
  110.   begin
  111.     LoadVideoModes(S);
  112.  
  113.     S.Read(TVVideoState, SizeOf(TVVideoState));
  114.     S.Read(LastFontNameLoaded, SizeOf(LastFontNameLoaded));
  115.     PToyApp(Application)^.LoadPalette(S);  (* requires Application <> Nil *)
  116.     VideoPalette.Load(S);
  117.     S.Read(LastFontTypeUsed, SizeOf(LastFontTypeUsed));
  118.  
  119.     if S.Status=stOK then
  120.       TVVideoState.Restore;
  121.   end;
  122.  
  123.  
  124.   (*******************************************************************
  125.     Store current video state on a stream
  126.   *******************************************************************)
  127.   procedure StoreVideoState(var S:TStream);
  128.     var
  129.       TVVideoState : VideoState;
  130.   begin
  131.     StoreVideoModes(S);
  132.  
  133.     TVVideoState.Save;
  134.     S.Write(TVVideoState, SizeOf(TVVideoState));
  135.     S.Write(LastFontNameLoaded, SizeOf(LastFontNameLoaded));
  136.     PToyApp(Application)^.StorePalette(S);
  137.     VideoPalette.Store(S);
  138.     S.Write(LastFontTypeUsed, SizeOf(LastFontTypeUsed));
  139.   end;
  140.  
  141.  
  142. (***************************************************************************
  143.   The application
  144. ***************************************************************************)
  145.  
  146.   (*******************************************************************
  147.     Init app, load a config file with video info if there (this is
  148.     what messes it up), create resource file if necessary
  149.     This code includes TToyApp's Init, so we call TApplication.Init
  150.     directly.
  151.     Ideally we don't call TApplication.Init at all, but rather init
  152.     the app first (without calling InitVideo) and then decide what
  153.     kind of video initalizing we want...
  154.   *******************************************************************)
  155.   constructor TResDemoApp.Init;
  156.     var
  157.       S         : TDosStream;
  158.       ConfigOK  : Boolean;
  159.       InitState : VideoState;
  160.   begin
  161.     Application:=@Self;         (* Cheat, cheat, cheat... (for LoadVideoState) *)
  162.  
  163.     RegisterObjects;
  164.     RegisterFontFile;
  165.     RegisterHelpFile;
  166.  
  167.     (*******************************************************************
  168.       Open and read config file if there is one
  169.     *******************************************************************)
  170.     { Do we have a config file? }
  171.     S.Init(ExeDir+CfgName, stOpenRead);
  172.     { This zeros VideoTypesToCheck if no cfg file, so checks only EVGA }
  173.     S.Read(VideoTypesToCheck, SizeOf(VideoTypesToCheck));
  174.  
  175.     CheckVideoType;             (* Determine video type *)
  176.     InitState.Save;             (* Use temporary variable... *)
  177.  
  178.     VideoPalette.Init;          (* Initialize palette *)
  179.  
  180.     LoadVideoState(S);          (* Load previously saved video state *)
  181.     S.Done;
  182.     ConfigOK:=S.Status=stOK;
  183.  
  184.     (*******************************************************************
  185.       Init app, TToyApp replacement code
  186.     *******************************************************************)
  187.     if ConfigOK then
  188.     begin
  189.       PreventModeSwitch;        (* We loaded a new video mode *)
  190.       VideoPalette.SetRGB(VideoPalette.RGB);
  191.     end;
  192.  
  193.     TApplication.Init;          (* We don't want to call TToyApp.Init *)
  194.     DosVideoState:=InitState;   (* Save startup video mode *)
  195.  
  196.     (* Get ScreenMode (if there is no cfg file) *)
  197.     ScreenMode:=GetSpecialVideoMode;
  198.  
  199.     (*******************************************************************
  200.       Introductory text
  201.     *******************************************************************)
  202.     HelpFileName:='HELPTEST.HLP';
  203.     ShowHelp(hcRezIntro);
  204.  
  205.     (*******************************************************************
  206.       Is there a resource file?  No? Create it!
  207.     *******************************************************************)
  208.     S.Init(ExeDir+ResName, stOpenRead);
  209.     S.Done;
  210.     if S.Status<>stOK then
  211.       CreateResourceFile;        { No, create it }
  212.  
  213.     (*******************************************************************
  214.       Open the resource file
  215.     *******************************************************************)
  216.     ResFile.Init(New(PBufStream, Init(ExeDir+ResName, stOpenRead, 1024)));
  217.  
  218.     if ResFile.Stream^.Status<>stOK then      (* OOPS! *)
  219.     begin
  220.       MessageBox(^C'Resource file not readable', Nil, mfError+mfOKButton);
  221.       Done;
  222.       Halt;
  223.     end;
  224.  
  225.     (*******************************************************************
  226.       Reload last font, might need resource file
  227.     *******************************************